home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / asocia1a / module1.bas < prev    next >
BASIC Source File  |  1999-10-22  |  5KB  |  104 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. Enum FlagConstants
  5.   cdlOFNAllowMultiselect = &H200 'The user can select more than one file atrun time by pressing the SHIFT key and using the UP ARROW and DOWN ARROW keys to select the desired files. When this is done, the FileName property returns a string containing the names of all selected files. The names in the string are delimited by spaces.
  6.   cdlOFNCreatePrompt = &H2000 ' Specifies that the dialog box prompts the user to create a file that doesn't currently exist. This flag automatically sets the cdlOFNPathMustExist and cdlOFNFileMustExist flags.
  7.   cdlOFNExplorer = &H80000 ' Use the Explorer-like Open A File dialog box template. Works with Windows 95 and Windows NT 4.0.
  8.   CdlOFNExtensionDifferent = &H400 ' Indicates that the extension of the returned filename is different from the extension specified by the DefaultExt property. This flag isn't set if the DefaultExt property is Null, if the extensions match, or if the file has no extension. This flag value can be checked upon closing the dialog box.
  9.   cdlOFNFileMustExist = &H1000 ' Specifies that the user can enter only names of existing files in the File Name text box. If this flag is set and the user enters an invalid filename, a warning is displayed. This flag automatically sets the cdlOFNPathMustExist flag.
  10.   cdlOFNHelpButton = &H10 ' Causes the dialog box to display the Help button.
  11.   cdlOFNHideReadOnly = &H4 'Hides the Read Onlycheck box.
  12.   cdlOFNLongNames = &H200000 ' Use long filenames.
  13.   cdlOFNNoChangeDir = &H8 'Forces the dialog box to set the current directory to what it was when the dialog box was opened.
  14.   CdlOFNNoDereferenceLinks = &H100000 ' Do not dereference shell links (also known as shortcuts). By default, choosing a shell link causes it to be dereferenced by the shell.
  15.   cdlOFNNoLongNames = &H40000 ' No long file names.
  16.   CdlOFNNoReadOnlyReturn = &H8000 ' Specifies that the returned file won't have the Read Only attribute set and won't be in a write-protected directory.
  17.   cdlOFNNoValidate = &H100 ' Specifies that the common dialog box allows invalid characters in the returned filename.
  18.   cdlOFNOverwritePrompt = &H2 'Causes the Save As dialog box to generate a message box if the selected file already exists. The user must confirm whether to overwrite the file.
  19.   cdlOFNPathMustExist = &H800 ' Specifies that the user can enter only valid paths. If this flag is set and the user enters an invalid path, a warning message is displayed.
  20.   cdlOFNReadOnly = &H1 'Causes the Read Only check box to be initially checked when the dialog box is created. This flag also indicates the state of the Read Only check box when the dialog box is closed.
  21.   cdlOFNShareAware = &H4000 ' Specifies that sharing violation errors will be ignored.
  22. End Enum
  23.  
  24. '*****************************************associate
  25. Private Declare Function RegCreateKey& Lib "advapi32.DLL" _
  26. Alias "RegCreateKeyA" (ByVal hKey&, ByVal lpszSubKey$, lphKey&)
  27.  
  28. Private Declare Function RegSetValue& Lib "advapi32.DLL" Alias "RegSetValueA" _
  29. (ByVal hKey&, ByVal lpszSubKey$, ByVal fdwType&, ByVal lpszValue$, ByVal dwLength&)
  30.  
  31. ' Return codes from Registration functions.
  32. Private Const ERROR_SUCCESS = 0&
  33. Private Const ERROR_BADDB = 1&
  34. Private Const ERROR_BADKEY = 2&
  35. Private Const ERROR_CANTOPEN = 3&
  36. Private Const ERROR_CANTREAD = 4&
  37. Private Const ERROR_CANTWRITE = 5&
  38. Private Const ERROR_OUTOFMEMORY = 6&
  39. Private Const ERROR_INVALID_PARAMETER = 7&
  40. Private Const ERROR_ACCESS_DENIED = 8&
  41. Private Const HKEY_CLASSES_ROOT = &H80000000
  42. Private Const MAX_PATH = 256&
  43. Private Const REG_SZ = 1
  44. '************************************************
  45.  
  46. Public Function Associate(ByVal apPath As String, ByVal Ext As String) As Boolean
  47.  
  48.   Dim sKeyName As String 'Holds Key Name in registry.
  49.   Dim sKeyValue As String 'Holds Key Value in registry.
  50.   Dim ret& 'Holds Error status If any from API calls.
  51.   Dim lphKey& 'Holds created key handle from RegCreateKey.
  52.   
  53.   Dim apTitle As String
  54.   
  55.   apTitle = ParseName(apPath)
  56.   
  57.   If InStr(Ext, ".") = 0 Then Ext = "." & Ext
  58.   
  59.   'register .ext files as belonging to app
  60.   sKeyName = Ext
  61.   sKeyValue = apTitle
  62.   ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
  63.   If ret& <> 0 Then GoTo AssocFailed
  64.   ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)
  65.   If ret& <> 0 Then GoTo AssocFailed
  66.   
  67.   'set open command to path and filename
  68.   sKeyName = apTitle
  69.   sKeyValue = apPath & " %1"
  70.   ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
  71.   If ret& <> 0 Then GoTo AssocFailed
  72.   ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, sKeyValue, MAX_PATH)
  73.   If ret& <> 0 Then GoTo AssocFailed
  74.   
  75.   'register app icon with .ext files
  76.   sKeyValue = apPath
  77.   ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
  78.   If ret& <> 0 Then GoTo AssocFailed
  79.   ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValue, MAX_PATH)
  80.   If ret& <> 0 Then GoTo AssocFailed
  81.   
  82.   Associate = True
  83.   Exit Function
  84.   
  85. AssocFailed:
  86.   Associate = False
  87. End Function
  88.  
  89. Public Function ParseName(ByVal sPath As String) As String
  90.   Dim strX As String
  91.   Dim intX As Integer
  92.   
  93.   intX = InStrRev(sPath, "\")
  94.   
  95.   strX = Trim(Right(sPath, Len(sPath) - intX))
  96.   If Right(strX, 1) = Chr(0) Then
  97.     ParseName = Left(strX, Len(strX) - 1)
  98.   Else
  99.     ParseName = strX
  100.   End If
  101. End Function
  102.  
  103.  
  104.